Cream of the Crop 21/Cream of the Crop 21 (Terry Blount) (October 1996).iso/os2/freetype.zip/olddbg.pas

Pascal/Delphi Source File | 1996-09-07 | 10.6 KB | 536 lines

(* The first text-mode version of the debugger. It seems to work though .. *)

program TTDEBUG;

uses Crt, TTTypes, TTError, TTTables, TTFile, TTIns;

type
  PShort = ^Int16;
  PLong  = ^Long;

  ByteHexStr  = string[2];    (* hex representation of a byte  *)
  ShortHexStr = string[4];    (*  "        "          "  short *)
  LongHexStr  = string[8];    (*  "        "          "  long  *)
  DebugStr    = string[128];  (* disassembled line output      *)

  PStorageLong = ^TStorageLong;
  TStorageLong = record       (* do-it-all union record type *)
           case Byte of
            0 : ( L     : LongInt );
            1 : ( S1, S2 : Integer );
            2 : ( W1, W2 : Word );
            3 : ( B1, B2,
              B3, B4 : Byte );
            4 : ( P     : Pointer );
          end;

var
  FileName    : String;
  Font_Buffer : PStorage;
  Out_File    : Text;
  T, I          : int;

  OpSize : int;

const
  OpStr : array[ 0..255 ] of String[10]
    = (
        'SVTCA  y',      (* Set vectors to coordinate axis y    *)
        'SVTCA  x',      (* Set vectors to coordinate axis x    *)
        'SPvTCA y',      (* Set Proj. vec. to coord. axis y     *)
        'SPvTCA x',      (* Set Proj. vec. to coord. axis x     *)
        'SFvTCA y',      (* Set Free. vec. to coord. axis y     *)
        'SFvTCA x',      (* Set Free. vec. to coord. axis x     *)
        'SPvTL //',      (* Set Proj. vec. parallel to segment  *)
        'SPvTL +',         (* Set Proj. vec. normal to segment    *)
        'SFvTL //',      (* Set Free. vec. parallel to segment  *)
        'SFvTL +',         (* Set Free. vec. normal to segment    *)
        'SPvFS',         (* Set Proj. vec. from stack        *)
        'SFvFS',         (* Set Free. vec. from stack        *)
        'GPV',         (* Get projection vector            *)
        'GFV',         (* Get freedom vector            *)
        'SFvTPv',         (* Set free. vec. to proj. vec.        *)
        'ISECT',         (* compute intersection            *)

        'SRP0',         (* Set reference point 0            *)
        'SRP1',         (* Set reference point 1            *)
        'SRP2',         (* Set reference point 2            *)
        'SZP0',         (* Set Zone Pointer 0            *)
        'SZP1',         (* Set Zone Pointer 1            *)
        'SZP2',         (* Set Zone Pointer 2            *)
        'SZPS',         (* Set all zone pointers            *)
        'SLOOP',         (* Set loop counter            *)
        'RTG',         (* Round to grid                *)
        'RTHG',         (* Round to half grid            *)
        'SMD',         (* Set Minimum Distance            *)
        'ELSE',         (* Else                    *)
        'JMPR',         (* Jump Relative                *)
        'SCvTCi',         (* Set CVT                 *)
        'SSwCi',         (*                     *)
        'SSW',         (*                     *)

        'DUP',
        'POP',
        'CLEAR',
        'SWAP',
        'DEPTH',
        'CINDEX',
        'MINDEX',
        'AlignPTS',
        'INS_$28',
        'UTP',
        'LOOPCALL',
        'CALL',
        'FDEF',
        'ENDF',
        'MDAP[0]',
        'MDAP[1]',

        'IUP[0]',
        'IUP[1]',
        'SHP[0]',
        'SHP[1]',
        'SHC[0]',
        'SHC[1]',
        'SHZ[0]',
        'SHZ[1]',
        'SHPIX',
        'IP',
        'MSIRP[0]',
        'MSIRP[1]',
        'AlignRP',
        'RTDG',
        'MIAP[0]',
        'MIAP[1]',

        'NPushB',
        'NPushW',
        'WS',
        'RS',
        'WCvtP',
        'RCvt',
        'GC[0]',
        'GC[1]',
        'SCFS',
        'MD[0]',
        'MD[1]',
        'MPPEM',
        'MPS',
        'FlipON',
        'FlipOFF',
        'DEBUG',

        'LT',
        'LTEQ',
        'GT',
        'GTEQ',
        'EQ',
        'NEQ',
        'ODD',
        'EVEN',
        'IF',
        'EIF',
        'AND',
        'OR',
        'NOT',
        'DeltaP1',
        'SDB',
        'SDS',

        'ADD',
        'SUB',
        'DIV',
        'MUL',
        'ABS',
        'NEG',
        'FLOOR',
        'CEILING',
        'ROUND[0]',
        'ROUND[1]',
        'ROUND[2]',
        'ROUND[3]',
        'NROUND[0]',
        'NROUND[1]',
        'NROUND[2]',
        'NROUND[3]',

        'WCvtF',
        'DeltaP2',
        'DeltaP3',
        'DeltaCn[0]',
        'DeltaCn[1]',
        'DeltaCn[2]',
        'SROUND',
        'S45Round',
        'JROT',
        'JROF',
        'ROFF',
        'INS_$7B',
        'RUTG',
        'RDTG',
        'SANGW',
        'AA',

        'FlipPT',
        'FlipRgON',
        'FlipRgOFF',
        'INS_$83',
        'INS_$84',
        'ScanCTRL',
        'SDVPTL[0]',
        'SDVPTL[1]',
        'GetINFO',
        'IDEF',
        'ROLL',
        'MAX',
        'MIN',
        'ScanTYPE',
        'IntCTRL',
        'INS_$8F',

        'INS_$90',
        'INS_$91',
        'INS_$92',
        'INS_$93',
        'INS_$94',
        'INS_$95',
        'INS_$96',
        'INS_$97',
        'INS_$98',
        'INS_$99',
        'INS_$9A',
        'INS_$9B',
        'INS_$9C',
        'INS_$9D',
        'INS_$9E',
        'INS_$9F',

        'INS_$A0',
        'INS_$A1',
        'INS_$A2',
        'INS_$A3',
        'INS_$A4',
        'INS_$A5',
        'INS_$A6',
        'INS_$A7',
        'INS_$A8',
        'INS_$A9',
        'INS_$AA',
        'INS_$AB',
        'INS_$AC',
        'INS_$AD',
        'INS_$AE',
        'INS_$AF',

        'PushB[0]',
        'PushB[1]',
        'PushB[2]',
        'PushB[3]',
        'PushB[4]',
        'PushB[5]',
        'PushB[6]',
        'PushB[7]',
        'PushW[0]',
        'PushW[1]',
        'PushW[2]',
        'PushW[3]',
        'PushW[4]',
        'PushW[5]',
        'PushW[6]',
        'PushW[7]',

        'MDRP[00]',
        'MDRP[01]',
        'MDRP[02]',
        'MDRP[03]',
        'MDRP[04]',
        'MDRP[05]',
        'MDRP[06]',
        'MDRP[07]',
        'MDRP[08]',
        'MDRP[09]',
        'MDRP[10]',
        'MDRP[11]',
        'MDRP[12]',
        'MDRP[13]',
        'MDRP[14]',
        'MDRP[15]',
        'MDRP[16]',
        'MDRP[17]',

        'MDRP[18]',
        'MDRP[19]',
        'MDRP[20]',
        'MDRP[21]',
        'MDRP[22]',
        'MDRP[23]',
        'MDRP[24]',
        'MDRP[25]',
        'MDRP[26]',
        'MDRP[27]',
        'MDRP[28]',
        'MDRP[29]',
        'MDRP[30]',
        'MDRP[31]',

        'MIRP[00]',
        'MIRP[01]',
        'MIRP[02]',
        'MIRP[03]',
        'MIRP[04]',
        'MIRP[05]',
        'MIRP[06]',
        'MIRP[07]',
        'MIRP[08]',
        'MIRP[09]',
        'MIRP[10]',
        'MIRP[11]',
        'MIRP[12]',
        'MIRP[13]',
        'MIRP[14]',
        'MIRP[15]',
        'MIRP[16]',
        'MIRP[17]',

        'MIRP[18]',
        'MIRP[19]',
        'MIRP[20]',
        'MIRP[21]',
        'MIRP[22]',
        'MIRP[23]',
        'MIRP[24]',
        'MIRP[25]',
        'MIRP[26]',
        'MIRP[27]',
        'MIRP[28]',
        'MIRP[29]',
        'MIRP[30]',
        'MIRP[31]'
     );

const
  HexStr : string[16] = '0123456789ABCDEF';


(**********)
(*  Hex8  *)
(**********)

function Hex8( B : Byte ) : ByteHexStr;
var
  S : ByteHexStr;
begin
  S[0] :=#2;
  S[1] := HexStr[ 1+( B shr 4 ) ];
  S[2] := HexStr[ 1+( B and 15 )];
  Hex8 := S;
end;

(***********)
(*  Hex16  *)
(***********)

function Hex16( W : word ) : ShortHexStr;
begin
  Hex16 := Hex8( Hi(w) )+Hex8( Lo(w) );
end;

(***********)
(*  Hex32  *)
(***********)

function Hex32( L : Long ) : LongHexStr;
begin
  Hex32 := Hex16( TStorageLong(L).W2 )+Hex16( TStorageLong(L).W1 );
end;

(****************)
(*  Cur_U_Line    *)
(****************)

function Cur_U_Line : DebugStr;
var
  Op   : Byte;
  N, I : Int;
  S    : DebugStr;
begin

  Op := Code^[IP];
  S  := '$'+Hex16(IP)+': '+Hex8(Op)+'  '+OpStr[Op];

  case Op of

    $40 : begin
       n := Code^[IP+1];
       S := S+'('+Hex8(n)+')';
       for i := 1 to n do
         S := S+' $'+Hex8( Code^[Ip+i+1] );
      end;

    $41 : begin
       n := Code^[IP+1];
       S := S+'('+Hex8(n)+')';
       for i := 1 to n do
         S := S+' $'+Hex8( Code^[Ip+i*2+1] )+Hex8( Code^[Ip+i*2+2] );
      end;

    $B0..$B7 : begin
         n := Op-$B0;
         for i := 0 to N do
           S := S+' $'+Hex8( Code^[Ip+i+1] );
           end;

    $B8..$BF : begin
         n := Op-$B8;
         for i := 0 to N do
           S := S+' $'+Hex8( Code^[IP+i*2+1] )+Hex8( Code^[Ip+i*2+2] );
           end;

  end;

  Cur_U_Line := S;
end;

procedure Do_Line;
begin
(*  writeln( Out_File,Cur_U_Line ); *)
  if not Run then
    begin
       Writeln('ERREUR : ', Error );
      halt(1);
    end;
end;




var
  Range : Int;
  P    : Pointer;

begin
  TextMode( co80+Font8x8 );

  GetMem( Font_Buffer, 64000 );

  InitBuffer( Font_Buffer^, 64000 );

  for i:=0 to ParamCount do Writeln(ParamStr(i));

  If paramCount<>1 then
   begin
    Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
    Halt(1);
   end;

  Filename := ParamStr(1);
  if Pos('.',FileName)=0 then FileName:=FileName+'.TTF';
  if not Open_TrueType_File( Filename ) then
   begin
    Writeln('Erreur, le fichier ',ParamStr(1),' n''a pu être ouvert');
    Halt(1);
   end;

  Load_TrueType_Tables;

  if not Load_TrueType_MaxProfile then
   begin
    Writeln('Erreur, la table ''maxp'' est introuvable');
    Halt(1);
   end;

  if not Load_TrueType_CVT then
   begin
    Writeln('Erreur, la table ''cvt '' est introuvable');
    Halt(1);
   end;

  if not Load_TrueType_Header then
   begin
    Writeln('Erreur, l''en-tête est introuvable');
    Halt(1);
   end;

  SetScale( 14, 96, Font_Header^.UnitsPerEM );

  if not Init_Interpreter( MaxProfile ) then
    begin
      Writeln('Erreur, initialisation interpréteur');
      Halt(1);
    end;

  T := LookUp_TrueType_Table('fpgm');

  if T < 0 then
    begin
      Writeln('FONT table not found');
      halt(1);
    end;

  Assign( Out_File,'' );
  Rewrite( Out_File );

  Writeln( Out_File,'Font Program Offset :', Table_Dir_Entries^[T].Offset );
  Writeln( Out_File,'Font Program Size     :', Table_Dir_Entries^[T].Length );

  CodeSize := Table_Dir_Entries^[T].Length;

  P := Alloc_CodeRange( Codesize, Range );
  if P = nil then
   begin
     writeln('Erreur, impossible d''allouer le font program' );
     halt(1);
   end;

  writeln( Out_File,'------- FONT -------');
  Read_At_Font_File( Table_Dir_Entries^[T].Offset,
             P^, CodeSize );

  if not Goto_CodeRange( Range, 0 ) then
   begin
    writeln('Erreur, référence invalide');
    Halt(1);
   end;

  Instruction_Trap := True;

  while IP < CodeSize do
   DO_Line;

  writeln( Out_File,'------- CVT -------');
  T := LookUp_TrueType_Table('prep');

  if T < 0 then
    begin
      Writeln('PREP table not found');
      halt(1);
    end;

  Writeln( Out_File,'CVT Program Offset :', Table_Dir_Entries^[T].Offset );
  Writeln( Out_File,'CVT Program Size    :', Table_Dir_Entries^[T].Length );

  CodeSize := Table_Dir_Entries^[T].Length;

  P := Alloc_CodeRange( Codesize, Range );
  if P = nil then
   begin
     writeln('Erreur, impossible d''allouer le CVT program' );
     halt(1);
   end;

  Read_At_Font_File( Table_Dir_Entries^[T].Offset,
             P^, CodeSize );

  if not Goto_CodeRange( Range, 0 ) then
   begin
    writeln('Erreur, référence invalide');
    Halt(1);
   end;

  while IP < CodeSize do
   DO_Line;

  writeln('-----------------------');

end.